home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume2 / basic / part2 < prev    next >
Encoding:
Internet Message Format  |  1986-11-30  |  45.0 KB
  1. From: ukma!david (David Herron, NPR Lover)
  2. Subject: A BASIC interpretor (Part 2 of 4)
  3. Newsgroups: mod.sources
  4. Approved: john@genrad.UUCP
  5.  
  6. Mod.sources:  Volume 2, Issue 24
  7. Submitted by: ukma!david (David Herron)
  8.  
  9.  
  10. #! /bin/sh
  11. # This is a shell archive, meaning:
  12. # 1. Remove everything above the #! /bin/sh line.
  13. # 2. Save the resulting text in a file.
  14. # 3. Execute the file with /bin/sh (not csh) to create the files:
  15. #    newbs/bsdefs.c
  16. #    newbs/bsdefs.h
  17. #    newbs/bsgram.y
  18. #    newbs/bslash.c
  19. #    newbs/bslib.c
  20. #    newbs/getplace.c
  21. #    newbs/gvadr.c
  22. #    newbs/makefile
  23. #    newbs/makefile.old
  24. #    newbs/mkop.c
  25. #    newbs/mkop.sh
  26. #    newbs/mksop.c
  27. #    newbs/num_ins.c
  28. #    newbs/op2.c
  29. #    newbs/operat.c
  30. #    newbs/scon_in.c
  31. # This archive created: Tue Jul 30 13:02:34 1985
  32. export PATH; PATH=/bin:$PATH
  33. if test ! -d 'newbs'
  34. then
  35.     echo shar: creating directory "'newbs'"
  36.     mkdir 'newbs'
  37. fi
  38. echo shar: extracting "'newbs/bsdefs.c'" '(1128 characters)'
  39. if test -f 'newbs/bsdefs.c'
  40. then
  41.     echo shar: will not over-write existing file "'newbs/bsdefs.c'"
  42. else
  43. sed 's/^X//' << \SHAR_EOF > 'newbs/bsdefs.c'
  44. /* bsdefs.c -- Actual definitions of all the variables.
  45.  *
  46.  * bsdefs.h only has the "extern's" of the things declared in here.
  47.  */
  48.  
  49. #include "bsdefs.h"
  50.  
  51.  
  52. /* Initial stuff for line number table.
  53.  *
  54.  * The line number table is a singly-linked list.  The head is "firstline",
  55.  * and the tail is "lastline".  The proper way to check for the end of the
  56.  * list is to compare it to LASTLINE.  Lastline points to itself in case
  57.  * I forget and code something differently (it also neatly ties up the end
  58.  * of the list).
  59.  */
  60.  
  61. #define LASTLINE    (struct line *)(&lastline)
  62.  
  63. struct line lastline = { &lastline,0077777,"",_nulline };
  64. struct line firstline = { &lastline,0,"",_nulline };
  65. struct line *curline = LASTLINE;
  66.  
  67.  
  68. /* Initial stuff for data statements.
  69.  *
  70.  * "dlist[]" holds pointers to lines that have data on them.  It is initialized
  71.  * in M_FIXUP.  "dlp" used to allocate entries from dlist[], it points to the
  72.  * first free entry.  "dlindx" points within the current data line to the next
  73.  * data item.
  74.  * "dtype" indicates the data type for the last data item.
  75.  */
  76.  
  77. struct line *dlist[DLSIZ];
  78. int dlp = 0,dlindx = 0, dtype = 0;
  79.  
  80. SHAR_EOF
  81. if test 1128 -ne "`wc -c < 'newbs/bsdefs.c'`"
  82. then
  83.     echo shar: error transmitting "'newbs/bsdefs.c'" '(should have been 1128 characters)'
  84. fi
  85. fi # end of overwriting check
  86. echo shar: extracting "'newbs/bsdefs.h'" '(4648 characters)'
  87. if test -f 'newbs/bsdefs.h'
  88. then
  89.     echo shar: will not over-write existing file "'newbs/bsdefs.h'"
  90. else
  91. sed 's/^X//' << \SHAR_EOF > 'newbs/bsdefs.h'
  92. /* bsdefs.h -- definition file for bs.
  93.  */
  94.  
  95. #include <stdio.h>
  96. #include <ctype.h>
  97.  
  98. /* 'Machine' status */
  99. extern int status;
  100. #define M_COMPILE    (1<<0)
  101. #define M_EXECUTE    (1<<1)
  102. #define M_INPUT        (1<<2)
  103. #define M_FIXUP        (1<<3)
  104. #define M_READ        (1<<4)
  105.  
  106. #define XMODE    (M_COMPILE|M_EXECUTE|M_INPUT|M_FIXUP|M_READ)
  107.  
  108.  
  109. /* line table. */
  110. #define LASTLINE    (struct line *)(&lastline)
  111.  
  112. struct line {
  113.     struct line *nextline;    /* next entry in list. */
  114.     int lnum;            /* its' number */
  115.     int (*list)();        /* its' definition */
  116.     char *text;            /* the original definition */
  117. };
  118.  
  119. extern struct line firstline,lastline,*curline;
  120.  
  121.  
  122. /* Variable types */
  123. #define Q_NRM    0    /* nice, ordinary variable */
  124. #define Q_ARY    1    /* array */
  125. #define Q_BF    2    /* builtin-function */
  126. #define Q_UFL    3    /* long user function */
  127. #define Q_UFS    4    /* short user function */
  128.  
  129.             /* in type part, a zero value is an undefined type. */
  130. #define T_INT    (1<<6)
  131. #define T_CHR    (2<<6)
  132. #define T_DBL    (3<<6)
  133. #define T_LBL    (4<<6)
  134.  
  135. #define T_QMASK        037        /* lower 5 bits for type qualifier */
  136. #define T_TMASK        (T_INT|T_CHR|T_DBL|T_LBL)
  137.  
  138. /* variable table */
  139. #define VLSIZ    150
  140.  
  141. struct label {
  142.     char *name;            /* what do we call it by. */
  143.     int (*where)();        /* and where does it live */
  144. };
  145. /* For arrays, storage of them is defined as follows:
  146.  *
  147.  *   1st item: number of dimensions in array <NDIMS>.
  148.  *   next <NDIMS> items: size of each dimension.
  149.  *   rest of items: the actual values.
  150.  *
  151.  * Until we can support varrying sized arrays this is the setup:
  152.  *
  153.  *   1,10,x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10
  154.  *
  155.  * for a total size of 13 items.
  156.  */
  157. union value {
  158.     long ival;        /* T_INT */
  159.     double rval;    /* T_DBL */
  160.     char *sval;        /* T_CHR */
  161.     struct label lval;  /* T_LBL */
  162.     struct line *locval; /* for pushing line# list entries */
  163.     union value *arval; /* any+Q_ARY */
  164.     struct dictnode *vpval; /* for use when pushing variable pointers */
  165.     union value *plval; /* for use when pushing pointers to a value */
  166. };
  167.  
  168. struct dictnode {    /* format of vlist entry */
  169.     struct dictnode *father,*daughter;    /* doubly-linked list. */
  170.     char *name;        /* name of entry. */
  171.     int type_of_value;    /* its type. */
  172.     union value val;    /* and its value */
  173. };
  174.  
  175. extern struct dictnode *dicthead,*dictail,*curvp;
  176.  
  177. /* '_' Function table */
  178. extern
  179.     _print(),      _goto(),    _if(),        _else(),
  180.     _for(),        _next(),    _read(),    _data(),
  181.     _dsep(),    _spop(),    _pop(),        _stop(),
  182.     _end(),        _dlabel(),    _rlabel(),    _contin(),
  183.     _leave(),    _enter(),    _exitlp(),    _iadd(),
  184.     _isub(),    _imult(),    _idiv(),    _imod(),
  185.     _comma(),    _radd(),    _rsub(),    _rmult(),
  186.     _rdiv(),    _scolon(),    _gosub(),    _return(),
  187.     _not(),        _ieq(),        _req(),        _seq(),
  188.     _ineq(),    _rneq(),    _sneq(),    _ileq(),
  189.     _rleq(),    _sleq(),    _ilt(),        _rlt(),
  190.     _slt(),        _igeq(),    _rgeq(),    _sgeq(),
  191.     _igt(),        _rgt(),        _sgt(),        _or(),
  192.     _and(),        _itoa(),    _rtoa(),    _itor(),
  193.     _rtoi(),    _pushstate(),    _popstate(),    _scon(),
  194.     _rcon(),    _icon(),    _val(),        _store(),
  195.     _var();
  196.  
  197. /*
  198.  * Data table.
  199.  * Array of pointers into llist.
  200.  * Each is a line which has data.
  201.  */
  202. #define DLSIZ    100
  203. extern struct line *dlist[]; /* actual table, number of elems. is DLSIZ */
  204. extern int dlp;        /* index into dlist for current line of data */
  205. extern int dlindx;    /* index into current line for current data item. */
  206. extern int dtype;    /* in M_READ, operators set this to the type of 
  207.              * their operation.  When the expression is done
  208.              * executing, this variable will indicate its type.
  209.              */
  210.  
  211. /* error routines */
  212. extern int ULerror();
  213. extern int STerror();
  214. extern int FNerror();
  215. extern int ODerror();
  216. extern int BDerror();
  217. extern int VTerror();
  218.  
  219.  
  220. /*
  221.  * unions for storing data types in the code list 
  222.  *
  223.  * Used to convert from a double (for instance) into "int" sized chunks
  224.  * for the purpose of manipulating instances of them in code lists.
  225.  */
  226.  
  227.  
  228. union doni {
  229.     double d_in_doni;
  230.     int i_in_doni[sizeof(double)/sizeof(int)];
  231. };
  232. union loni {
  233.     long l_in_loni;
  234.     int i_in_loni[sizeof(long)/sizeof(int)];
  235. };
  236. union voni {
  237.     union value v_in_voni;
  238.     int i_in_voni[sizeof(union value)/sizeof(int)];
  239. };
  240.  
  241.  
  242. /* miscellaneous definitions. */
  243.  
  244. #define STKSIZ    500
  245. extern union value stack[];
  246. extern int stackp;
  247. extern int push();
  248. extern union value pop();
  249.  
  250. #define CSTKSIZ    5
  251. #define BFSIZ    200    /* input buffer */
  252. extern char pbbuf[];    /* unput() buffer */
  253. extern char ibuf[];
  254. extern int iptr,pbptr;
  255. extern char input();
  256. extern rdlin(),unput();
  257.  
  258. extern blcpy();
  259.  
  260. extern char bslash();
  261. extern char *scon_in();
  262. extern int num_in();
  263.  
  264. extern char *myalloc();
  265. extern union value *getplace();
  266. extern struct line *gllentry();
  267.  
  268. extern FILE *bsin;
  269.  
  270. extern int dbg;        /* debugging flag. */
  271. extern long atol();
  272. extern double atof();
  273. SHAR_EOF
  274. if test 4648 -ne "`wc -c < 'newbs/bsdefs.h'`"
  275. then
  276.     echo shar: error transmitting "'newbs/bsdefs.h'" '(should have been 4648 characters)'
  277. fi
  278. fi # end of overwriting check
  279. echo shar: extracting "'newbs/bsgram.y'" '(8891 characters)'
  280. if test -f 'newbs/bsgram.y'
  281. then
  282.     echo shar: will not over-write existing file "'newbs/bsgram.y'"
  283. else
  284. sed 's/^X//' << \SHAR_EOF > 'newbs/bsgram.y'
  285.     /* bsgram.y -- grammer specification for bs.
  286.      */
  287. %{
  288. #include "bsdefs.h"
  289.  
  290. char *p;        /* the generic pointer */
  291. int i;            /* the generic counter */
  292. int (*l[300])();    /* array to generate the code list into. */
  293. int lp;            /* pointer to current spot in l[] */
  294.  
  295. struct stk {
  296.     int stack[40];
  297.     int stkp;
  298. };
  299.  
  300. struct stk ifstk,whstk,forstk,repstk,lpstk;
  301. int gomax=0, ifmax=0, whmax=0, formax=0, repmax=0, lpmax=0;
  302.  
  303. extern char *yytext;
  304. extern char *bsyysval;
  305. extern int yyleng;
  306. %}
  307.  
  308. %term EQUAL    NEQ    LE    LT    GE    WHILE
  309. %term GT    OR    AND    NOT    RET    REPEAT
  310. %term IF    THEN    ELSE    GOTO    GOSUB    UNTIL
  311. %term STOP    END    INTEGER    REAL    SCONST    ELIHW
  312. %term LET    SWORD    PRINT    INPUT    DATA    CFOR
  313. %term FOR    TO    STEP    READ    WRITE    NEXT
  314. %term DEFINE    LFUN    SFUN    FDEF    SYMBOL    DIM
  315. %term VALUE    IWORD    RWORD    ROFC    LOOP    EXITIF
  316. %term ITOR    RTOI    ITOA    RTOA    LEAVE    CONTINUE
  317. %term POOL
  318.  
  319. %left ',' ';'
  320. %right '='
  321. %nonassoc OR AND
  322. %nonassoc LE LT GE GT EQUAL NEQ
  323. %left '+' '-'
  324. %left '*' '/' '%'
  325. %left UNARY
  326. %left '('
  327.  
  328.  
  329. %start lines
  330.  
  331. %%
  332.  
  333. lines        : /* empty */
  334.         | lines line
  335.         ;
  336.  
  337. line        : lnum stat '\n'
  338.             { printf("\n"); }
  339.         | '\n'
  340.         ;
  341.  
  342. lnum        : INTEGER
  343.             { bundle(2,_line,atoi($1); }
  344.         ;
  345.  
  346. stat        : LET let_xpr
  347.         | let_xpr
  348.         | PRINT pe
  349.             { bundle(1,_print); }
  350.         | GOTO INTEGER
  351.             {
  352.                 sprintf(s,"LN%s",$2);
  353.                 bundle(4,_rlabel,gvadr(s,T_LBL),_goto,0);
  354.             }
  355.         | GOSUB INTEGER
  356.             {
  357.                 sprintf(s,"LN%s",$2);
  358.                 bundle(4,_rlabel,gvadr(s,T_LBL),_gosub,0); 
  359.             }
  360.         | LEAVE
  361.             { bundle(2,_leave,0); }
  362.         | CONTINUE
  363.             { bundle(2,_contin,0); }
  364.         | RET
  365.             { bundle(1,_return); }
  366.         | IF bexpr
  367.             {
  368.                 lpush(&ifstk,ifmax);
  369.                 sprintf(s,"IF%d",ifmax);
  370.                 bundle(4,_rlabel,gvadr(s,T_LBL),_if,0);
  371.                 ifmax += 2;
  372.             }
  373.           THEN stat
  374.             {
  375.                 i = ltop(&ifstk);
  376.                 sprintf(s,"IF%d",i+1);
  377.                 bundle(4,_rlabel,gvadr(s,T_LBL),_goto,0);
  378.             }
  379.           if_else
  380.         | INPUT 
  381.             { bundle(2,_pushstate,M_INPUT); }
  382.           var_lst
  383.             { bundle(1,_popstate); }
  384.         | STOP
  385.             { bundle(1,_stop); }
  386.         | END
  387.             { bundle(1,_end); }
  388.         | FOR nvar '=' rexpr TO rexpr for_step
  389.             {
  390.                 lpush(&forstk,formax);
  391.                 sprintf(s,"FOR%d",formax+2);
  392.                 bundle(2,_rlabel,gvadr(s,T_LBL));
  393.                 sprintf(s,"FOR%d",formax+1);
  394.                 bundle(3,_rlabel,gvadr(s,T_LBL),_enter);
  395.                 sprintf(s,"FOR%d",formax+1);
  396.                 bundle(5,_icon,(long)0,_rlabel,gvadr(s,T_LBL));
  397.                 sprintf(s,"FOR%d",formax);
  398.                 bundle(4,_dlabel,gvadr(s,T_LBL),_for,0);
  399.                 formax += 3;
  400.             }
  401.         | NEXT
  402.             {
  403.                 i = ltop(&forstk);
  404.                 sprintf(s,"FOR%d",i+2);
  405.                 bundle(2,_dlabel,gvadr(s,T_LBL));
  406.             }
  407.           nvar
  408.             {
  409.                 i = lpop(&forstk);
  410.                 sprintf(s,"FOR%d",i);
  411.                 bundle(5,_next,_rlabel,gvadr(s,T_LBL),_goto,0);
  412.                 sprintf(s,"FOR%d",i+1);
  413.                 bundle(3,_dlabel,gvadr(s,T_LBL),_exitlp);
  414.             }
  415.         | READ 
  416.             { bundle(2,_pushstate,M_READ); }
  417.           var_lst
  418.             { bundle(1,_popstate); }
  419.         | DATA 
  420.             { bundle(2,_data,0); }
  421.            data_lst
  422.         | LOOP
  423.             {
  424.                 lpush(&lpstk,lpmax);
  425.                 sprintf(s,"LP%d",lpmax+2);
  426.                 bundle(2,_rlabel,gvadr(s,T_LBL));
  427.                 sprintf(s,"LP%d",lpmax+1);
  428.                 bundle(3,_rlabel,gvadr(s,T_LBL),_enter);
  429.                 sprintf(s,"LP%d",lpmax);
  430.                 bundle(2,_dlabel,gvadr(s,T_LBL));
  431.                 lpmax += 3;
  432.             }
  433.         | EXITIF bexpr
  434.             {
  435.                 i = ltop(&lpstk);
  436.                 sprintf(s,"LP%d",i+1);
  437.                 bundle(5,_not,_rlabel,gvadr(s,T_LBL),_if,0);
  438.             }
  439.         | POOL
  440.             {
  441.                 i = lpop(&lpstk);
  442.                 sprintf(s,"LP%d",i+2);
  443.                 bundle(2,_dlabel,gvadr(s,T_LBL));
  444.                 sprintf(s,"LP%d",i);
  445.                 bundle(4,_rlabel,gvadr(s,T_LBL),_goto,0);
  446.                 sprintf(s,"LP%d",i+1);
  447.                 bundle(3,_dlabel,gvadr(s,T_LBL),_exitlp);
  448.             }
  449.         | WHILE
  450.             {
  451.                 lpush(&whstk,whmax);
  452.                 sprintf(s,"WH%d",whmax+2);
  453.                 bundle(2,_rlabel,gvadr(s,T_LBL));
  454.                 sprintf(s,"WH%d",whmax+1);
  455.                 bundle(3,_rlabel,gvadr(s,T_LBL),_enter);
  456.                 sprintf(s,"WH%d",whmax);
  457.                 bundle(2,_rlabel,gvadr(s,T_LBL));
  458.                 whmax += 3;
  459.             }
  460.           bexpr
  461.             {
  462.                 i = ltop(&whstk);
  463.                 sprintf(s,"WH%d",i+1);
  464.                 bundle(4,_rlabel,gvadr(s,T+LBL),_if,0);
  465.             }
  466.         | ELIHW
  467.             {
  468.                 i = lpop(&whstk);
  469.                 sprintf(s,"WH%d",i+2);
  470.                 bundle(2,_dlabel,gvadr(s,T_LBL));
  471.                 sprintf(s,"WH%d",i)
  472.                 bundle(4,_rlabel,gvadr(s,T_LBL),_goto,0);
  473.                 sprintf(s,"WH%d",i+1);
  474.                 bundle(3,_dlabel,gvadr(s,T_LBL),_exitlp);
  475.             }
  476.         | REPEAT
  477.             {
  478.                 lpush(&repstk,repmax);
  479.                 sprintf(s,"REP%d",repmax+1);
  480.                 bundle(2,_rlabel,gvadr(s,T_LBL));
  481.                 sprintf(s,"REP%d",repmax+2);
  482.                 bundle(3,_rlabel,gvadr(s,T_LBL),_enter);
  483.                 sprintf(s,"REP%d",repmax);
  484.                 bundle(2,_dlabel,gvadr(s,T_LBL));
  485.                 repmax += 3;
  486.             }
  487.         | UNTIL
  488.             {
  489.                 i = ltop(&repstk);
  490.                 sprintf(s,"REP%d",i+1);
  491.                 bundle(2,_dlabel,gvadr(s,T_LBL));
  492.             }
  493.           bexpr
  494.             {
  495.                 i = lpop(&repstk);
  496.                 sprintf(s,"REP%d",i);
  497.                 bundle(5,_not,_rlabel,gvadr(s,T_LBL),_if,0);
  498.                 sprintf(s,"REP%d",i+2);
  499.                 bundle(3,_dlabel,gvadr(s,T_LBL),_exitlp);
  500.             }
  501.         ;
  502.  
  503. nvar        : ivar
  504.         | rvar
  505.         ;
  506.  
  507. let_xpr        : ivar '=' rexpr
  508.             { bundle(4,_rtoi,_store,T_DBL,_pop); }
  509.         | rvar '=' rexpr
  510.             { bundle(3,_store,T_DBL,_pop); }
  511.         | svar '=' sexpr
  512.             { bundle(3,_store,T_CHR,spop); }
  513.         ;
  514.  
  515. data_lst    : rexpr
  516.             { bundle(2,_dsep,0); }
  517.         | sexpr
  518.             { bundle(1,_dsep); }
  519.         | data_lst ',' rexpr
  520.             { bundle(1,_dsep); }
  521.         | data_lst ',' sexpr
  522.             { bundle(1,_dsep); }
  523.         ;
  524.  
  525. ind_lst        : rexpr
  526.         | ind_lst ',' rexpr
  527.         ;
  528.  
  529. for_step    : /* empty */
  530.             { bundle(3,_icon,(long)0); }
  531.         | STEP rexpr
  532.         ;
  533.  
  534. if_else        : /* empty */
  535.             {
  536.                 i = lpop(&ifstk);
  537.                 sprintf(s,"IF%d",i);
  538.                 bundle(2,_dlabel,gvadr(s,T_LBL));
  539.                 sprintf(s,"IF%d",i+1);
  540.                 bundle(2,_dlabel,gvadr(s,T_LBL));
  541.             }
  542.         | ELSE 
  543.             {
  544.                 i = ltop(&ifstk);
  545.                 sprintf(s,"IF%d",i);
  546.                 bundle(2,_dlabel,gvadr(s,T_LBL));
  547.             }
  548.           stat
  549.             {
  550.                 i = lpop(&ifstk);
  551.                 sprintf(s,"IF%d",i+1);
  552.                 bundle(2,_dlabel,gvadr(s,T_LBL));
  553.             }
  554.         ;
  555.  
  556.  
  557. pe        : sexpr ','
  558.             { bundle(3,_scon,"",_comma); }
  559.         | sexpr ';'
  560.         | sexpr
  561.             { bundle(3,_scon,"\\n",_scolon); }
  562.         | /* empty */
  563.             { bundle(2,_scon,"\\n"); }
  564.         ;
  565.  
  566.  
  567. var_lst        : ivar
  568.         | rvar
  569.         | svar
  570.         | var_lst ',' var_lst
  571.         ;
  572.  
  573. sexpr        : SCONST
  574.             { p=myalloc(yyleng); strcpy(p,$1); bundle(2,_scon,p); }
  575.         | svar
  576.             { bundle(2,_val,T_CHR); }
  577.         | rexpr
  578.             { bundle(1,_rtoa); }
  579.         | svar '=' sexpr
  580.             { bundle(2,_store,T_CHR); }
  581.         | sexpr ';' sexpr
  582.             { bundle(1,_scolon); }
  583.         | sexpr '+' sexpr
  584.             { bundle(1,_scolon); }
  585.         | sexpr ',' sexpr
  586.             { bundle(1,_comma); }
  587.         | '(' sexpr ')'
  588.         ;
  589. sbe        : sexpr EQUAL sexpr
  590.             { bundle(1,_seq); }
  591.         | sexpr NEQ sexpr
  592.             { bundle(1,_sneq); }
  593.         | sexpr LE sexpr
  594.             { bundle(1,_sleq); }
  595.         | sexpr LT sexpr
  596.             { bundle(1,_slt); }
  597.         | sexpr GE sexpr
  598.             { bundle(1,_sgeq); }
  599.         | sexpr GT sexpr
  600.             { bundle(1,_sgt); }
  601.         ;
  602.  
  603. ivar        : IWORD
  604.             { bundle(2,_var,gvadr($1,T_INT)); }
  605.         | IWORD '(' 
  606.             { bundle(2,_pushstate,M_EXECUTE); }
  607.           ind_lst ')'
  608.             { bundle(3,_popstate,_var,gvadr($1,T_INT+Q_ARY)); }
  609.         ;
  610. rvar        : RWORD
  611.             { bundle(2,_var,gvadr($1,T_DBL)); }
  612.         | RWORD '(' 
  613.             { bundle(2,_pushstate,M_EXECUTE); }
  614.           ind_lst ')'
  615.             { bundle(3,_popstate,_var,gvadr($1,T_DBL+Q_ARY)); }
  616.         ;
  617.  
  618. svar        : SWORD
  619.             { bundle(2,_var,gvadr($1,T_CHR)); }
  620.         | SWORD '(' 
  621.             { bundle(2,_pushstate,M_EXECUTE); }
  622.           ind_lst ')'
  623.             { bundle(3,_popstate,_var,gvadr($1,T_CHR+Q_ARY)); }
  624.         ;
  625.  
  626.  
  627.  
  628. rexpr        : rvar
  629.             { bundle(2,_val,T_DBL); }
  630.         | REAL
  631.             { bundle(5,_rcon,(double)atof($1)); }
  632.         | INTEGER
  633.             { bundle(5,_rcon,(double)atof($1)); }
  634.         | ivar
  635.             { bundle(3,_val,T_INT,_itor); }
  636.         | rvar '=' rexpr
  637.             { bundle(2,_store,T_DBL); }
  638.         | '(' rexpr ')'
  639.         | rexpr '+' rexpr
  640.             { bundle(1,_radd); }
  641.         | rexpr '-' rexpr
  642.             { bundle(1,_rsub); }
  643.         | rexpr '*' rexpr
  644.             { bundle(1,_rmult); }
  645.         | rexpr '/' rexpr
  646.             { bundle(1,_rdiv); }
  647.         | '+' rexpr    %prec UNARY
  648.         | '-' rexpr    %prec UNARY
  649.             { bundle(6,_rcon,(double)(-1),_rmult); }
  650.         ;
  651.  
  652. rbe        : rexpr EQUAL rexpr
  653.             { bundle(1,_req); }
  654.         | rexpr NEQ rexpr
  655.             { bundle(1,_rneq); }
  656.         | rexpr LE rexpr
  657.             { bundle(1,_rleq); }
  658.         | rexpr LT rexpr
  659.             { bundle(1,_rlt); }
  660.         | rexpr GE rexpr
  661.             { bundle(1,_rgeq); }
  662.         | rexpr GT rexpr
  663.             { bundle(1,_rgt); }
  664.         ;
  665. bexpr        : sbe
  666.         | rbe
  667.         | NOT bexpr    %prec UNARY
  668.             { bundle(1,_not); }
  669.         | bexpr OR bexpr
  670.             { bundle(1,_or); }
  671.         | bexpr AND bexpr
  672.             { bundle(1,_and); }
  673.         | '(' bexpr ')'
  674.         ;
  675. %%
  676.  
  677. main()
  678. {
  679.     rdlin(bsin);
  680.     return(yyparse());
  681. }
  682.  
  683. yyerror(s)
  684. char *s;
  685. {
  686.     fprintf(stderr,"%s\n",s);
  687. }
  688.  
  689. lpush(stack,val) struct stk *stack; int val;
  690. {
  691.     stack->stack[stack->stkp++] = val; 
  692. }
  693.  
  694. int ltop(stack) struct stk *stack;
  695. { 
  696.     return(stack->stack[stack->stkp-1]); 
  697. }
  698.  
  699. int lpop(stack) struct stk *stack;
  700. { 
  701.     return(stack->stack[--stack->stkp]); 
  702. }
  703.  
  704. /* bundle() -- append argument list to l[].  Idea tooken from bc.y.
  705.  *
  706.  * Usage:  bundle(cnt,arg,arg,...,arg)
  707.  *
  708.  * The "arg"'s can be anything.  "cnt" is a count of the number of integers
  709.  * it would take to hold all the args.
  710.  *
  711.  * e.g.  bundle(4,(double)a); is the correct count for a.
  712.  *
  713.  *    ******* NOTE *******
  714.  *
  715.  * This routine is machine dependant.  It depends on the way arguments are
  716.  * passed on the stack on the PDP-11 machines.  It may not work elsewhere.
  717.  */
  718. bundle(a)
  719. int a;
  720. {
  721.     register int *p;
  722.     register int sz;
  723.  
  724.     p = &a;
  725.     sz = *p++;
  726.     while(sz-- > 0) 
  727.     l[lp++] = *p++;
  728. }
  729. SHAR_EOF
  730. if test 8891 -ne "`wc -c < 'newbs/bsgram.y'`"
  731. then
  732.     echo shar: error transmitting "'newbs/bsgram.y'" '(should have been 8891 characters)'
  733. fi
  734. fi # end of overwriting check
  735. echo shar: extracting "'newbs/bslash.c'" '(567 characters)'
  736. if test -f 'newbs/bslash.c'
  737. then
  738.     echo shar: will not over-write existing file "'newbs/bslash.c'"
  739. else
  740. sed 's/^X//' << \SHAR_EOF > 'newbs/bslash.c'
  741. /* bslash() -- have seen '\', use input() to say what is actually wanted.
  742.  */
  743. char bslash()
  744. {
  745.     char text[8];
  746.     register char *s,c;
  747.     int v;
  748.  
  749.     c=input();
  750.     if(c == 'n') c='\n';
  751.     else if(c == 't') c='\t';
  752.     else if(c == 'b') c='\b';
  753.     else if(c == 'r') c='\r';
  754.     else if(c == 'f') c='\f';
  755.     else if(c>='0' && c<='7') { /* octal digit string */
  756.     s = &text[0];
  757.     *s++ = c;
  758.     c=input();
  759.     while(c>='0' && c<='7') {
  760.         *s++ = c;
  761.         c=input();
  762.     }
  763.     *s++ = '\0';
  764.     sscanf(text,"%o",&v);
  765.     c = (char) v;
  766.     }
  767.     else if(c=='\n') rdlin(bsin);
  768.     return(c);
  769. }
  770. SHAR_EOF
  771. if test 567 -ne "`wc -c < 'newbs/bslash.c'`"
  772. then
  773.     echo shar: error transmitting "'newbs/bslash.c'" '(should have been 567 characters)'
  774. fi
  775. fi # end of overwriting check
  776. echo shar: extracting "'newbs/bslib.c'" '(1553 characters)'
  777. if test -f 'newbs/bslib.c'
  778. then
  779.     echo shar: will not over-write existing file "'newbs/bslib.c'"
  780. else
  781. sed 's/^X//' << \SHAR_EOF > 'newbs/bslib.c'
  782. /* bslib.c -- subroutine library, routines useful anywhere.
  783.  */
  784.  
  785. #include "bsdefs.h"
  786.  
  787. XFILE *bsin = stdin;
  788.  
  789. /* blcpy -- copies a block of memory (l bytes) from s to d.
  790.  */
  791. blcpy(d,s,l)
  792. char *d,*s;
  793. int l;
  794. {
  795.     for(; l >= 0; (l--)) *(d++) = *(s++);
  796. }
  797.  
  798. /* Input routines.  These routines buffer input a line at a time into
  799.  * ibuf.  Unputted input goes to pbbuf, and gets read before things in
  800.  * ibuf, if anything in pbbuf.
  801.  */
  802.  
  803. char pbbuf[CSTKSIZ],ibuf[BFSIZ];
  804.  
  805. int iptr = -1;
  806. int pbptr = -1;
  807.  
  808. char input()
  809. {
  810.     if(pbptr > -1)
  811.     return(pbbuf[pbptr--]);
  812.     else {
  813.     if(ibuf[iptr] == '\0') rdlin(bsin);
  814.     if(ibuf[iptr]!='\0' && !feof(bsin))
  815.         return(ibuf[iptr++]);
  816.     else
  817.         return(0);
  818.     }
  819. }
  820.  
  821. rdlin(f) FILE *f;
  822. {
  823.     char c;
  824.  
  825.     iptr = 0;
  826.     for(c=fgetc(f); c!='\n' && c!=EOF; c=fgetc(f)) ibuf[iptr++] = c;
  827.     ibuf[iptr++] = c;
  828.     ibuf[iptr++] = '\0';
  829.     iptr = 0;
  830. }
  831.  
  832. unput(c) char c;
  833. { pbbuf[++pbptr] = c; }
  834.  
  835. /* myalloc() -- allocate, checking for out of memory.
  836.  */
  837. char *myalloc(nb)
  838. int nb;
  839. {
  840.     char *rval;
  841.     rval = malloc(nb);
  842. /*
  843.     printf("myalloc:tos:%o,rv:%o,nb:%d,e:%o\n",&rval,rval,nb,sbrk(0));
  844. */
  845.     if(rval == 0) {
  846.     fprintf(stderr,"myalloc: out of memory\n");
  847.     exit(1);
  848.     }
  849.     return(rval);
  850. }
  851.  
  852.  
  853.  
  854. /* Stack routines.  Very simple. */
  855.  
  856. union value stack[STKSIZ];
  857. int stackp = -1;
  858.  
  859. push(i) union value i;
  860. {
  861.     stack[++stackp] = i;
  862. }
  863.  
  864. union value pop()
  865. {
  866.     return(stack[stackp--]);
  867. }
  868.  
  869. /* Mark stack.  Also very simple. */
  870. int mstack[5];
  871. int mstkp = -1;
  872. mpush()
  873. { mstack[++mstkp] = stackp; }
  874. mpop()
  875. { stackp = mstack[mstkp--]; }
  876. SHAR_EOF
  877. if test 1553 -ne "`wc -c < 'newbs/bslib.c'`"
  878. then
  879.     echo shar: error transmitting "'newbs/bslib.c'" '(should have been 1553 characters)'
  880. fi
  881. fi # end of overwriting check
  882. echo shar: extracting "'newbs/getplace.c'" '(488 characters)'
  883. if test -f 'newbs/getplace.c'
  884. then
  885.     echo shar: will not over-write existing file "'newbs/getplace.c'"
  886. else
  887. sed 's/^X//' << \SHAR_EOF > 'newbs/getplace.c'
  888. /* getplace() -- get a pointer to place of value for vlist entry on top of stack
  889.  *    For arrays, getplace() expects the indexes to be on the stack as well.
  890.  *    The parser should properly arrange for this to happen.
  891.  */
  892. union value *getplace(dp)
  893. struct dictnode *dp;
  894. {
  895.     int qual;
  896.     union value ind,*place;
  897.  
  898.     qual = dp->type_of_value&T_QMASK;
  899.     if(qual == Q_ARY) {
  900.     ind = pop();
  901.     mpop();
  902.     place = & dp->val.arval[ind.ival+2];
  903.     }
  904.     else
  905.     place = & dp->val;
  906.     return(place);
  907. }
  908. SHAR_EOF
  909. if test 488 -ne "`wc -c < 'newbs/getplace.c'`"
  910. then
  911.     echo shar: error transmitting "'newbs/getplace.c'" '(should have been 488 characters)'
  912. fi
  913. fi # end of overwriting check
  914. echo shar: extracting "'newbs/gvadr.c'" '(911 characters)'
  915. if test -f 'newbs/gvadr.c'
  916. then
  917.     echo shar: will not over-write existing file "'newbs/gvadr.c'"
  918. else
  919. sed 's/^X//' << \SHAR_EOF > 'newbs/gvadr.c'
  920. /* gvadr() -- Get variable address from vlist, with type checking.
  921.  *    This routine allows numerous copies of same name as long as
  922.  *    all copies have different types.  Probably doesnt matter since
  923.  *    the parser does the type checking.
  924.  */
  925. struct dictnode *gvadr(s,ty)
  926. char *s;
  927. int ty;
  928. {
  929.     register int i;
  930.     register int qual; /* type qualifier */
  931.  
  932.     /* Inefficient */
  933.     for(i=0; vlist[i].name!=0 && i<VLSIZ; i++)
  934.     if(vlist[i].type_of_value==ty && strcmp(s,vlist[i].name)==0)
  935.         /* match found */
  936.             break;
  937.     if(i >= VLSIZ) {
  938.     fprintf(stderr,"gvadr: out of room in variable list for %s\n",s);
  939.     exit(1);
  940.     }
  941.     /* not on list, enter it */
  942.     if(vlist[i].name == 0) {
  943.     vlist[i].name = myalloc(strlen(s)+1);
  944.     strcpy(vlist[i].name,s);
  945.     vlist[i].val.rval = 0;
  946.     vlist[i].type_of_value = ty;
  947.     if(ty&T_QMASK == Q_ARY)
  948.         vlist[i].val.arval = myalloc(13*sizeof(union value));
  949.     }
  950.     return(&vlist[i]);
  951. }
  952. SHAR_EOF
  953. if test 911 -ne "`wc -c < 'newbs/gvadr.c'`"
  954. then
  955.     echo shar: error transmitting "'newbs/gvadr.c'" '(should have been 911 characters)'
  956. fi
  957. fi # end of overwriting check
  958. echo shar: extracting "'newbs/makefile'" '(193 characters)'
  959. if test -f 'newbs/makefile'
  960. then
  961.     echo shar: will not over-write existing file "'newbs/makefile'"
  962. else
  963. sed 's/^X//' << \SHAR_EOF > 'newbs/makefile'
  964. operat2.o: mkop.sh op rop sop
  965.     mkop.sh >operat2.c
  966.     cc -c operat2.c
  967.     rm operat2.c
  968.     : done operat2.o
  969. op: mkop.c
  970.     cc mkop.c -o op
  971. rop: mkrbop.c
  972.     cc mkrbop.c -o rop
  973. sop: mksop.c
  974.     cc mksop.c -o sop
  975. SHAR_EOF
  976. if test 193 -ne "`wc -c < 'newbs/makefile'`"
  977. then
  978.     echo shar: error transmitting "'newbs/makefile'" '(should have been 193 characters)'
  979. fi
  980. fi # end of overwriting check
  981. echo shar: extracting "'newbs/makefile.old'" '(661 characters)'
  982. if test -f 'newbs/makefile.old'
  983. then
  984.     echo shar: will not over-write existing file "'newbs/makefile.old'"
  985. else
  986. sed 's/^X//' << \SHAR_EOF > 'newbs/makefile.old'
  987. OFILES = lex.o bsint.o action.o operat.o bslib.o errors.o
  988. PRSO= bsgram.o lex.o bslib.o
  989. INTO= bsint.o action.o operat2.o operat.o bslib.o errors.o
  990.  
  991. prs: ${PRSO}
  992.     cc -s ${PRSO} -o prs
  993. bsgram.o: bsgram.c bsdefs.h
  994.     cc -c bsgram.c
  995. bsgram.c: bsgram.y
  996.     yacc -d bsgram.y
  997.     mv y.tab.c bsgram.c
  998.     mv y.tab.h bstokens.h
  999.  
  1000. int: ${INTO}
  1001.     cc ${INTO} -o int
  1002.  
  1003. ${OFILES}: bsdefs.h
  1004.  
  1005. operat2.o: mkop.sh op rop sop
  1006.     mkop.sh >operat2.c
  1007.     cc -c operat2.c
  1008.     rm operat2.c
  1009.     : done operat2.o
  1010. op: mkop.c
  1011.     cc mkop.c -o op
  1012. rop: mkrbop.c
  1013.     cc mkrbop.c -o rop
  1014. sop: mksop.c
  1015.     cc mksop.c -o sop
  1016.  
  1017. pr:
  1018.     pr bsgram.y lex.c bsdefs.h bslib.c bsint.c action.c operat.c mkop.c mkrbop.c mksop.c errors.c | lpr
  1019. SHAR_EOF
  1020. if test 661 -ne "`wc -c < 'newbs/makefile.old'`"
  1021. then
  1022.     echo shar: error transmitting "'newbs/makefile.old'" '(should have been 661 characters)'
  1023. fi
  1024. fi # end of overwriting check
  1025. echo shar: extracting "'newbs/mkop.c'" '(1030 characters)'
  1026. if test -f 'newbs/mkop.c'
  1027. then
  1028.     echo shar: will not over-write existing file "'newbs/mkop.c'"
  1029. else
  1030. sed 's/^X//' << \SHAR_EOF > 'newbs/mkop.c'
  1031. /* mkop.c -- make operator function for bs.
  1032. *
  1033. *    USAGE: op name type oper tag
  1034. *
  1035. * where:    name: name of function generated.
  1036. *        type: data type of operation.
  1037. *        oper: operator for operation.
  1038. *        tag: structure tag name.
  1039. *
  1040. * This will only work with T_INT and T_DBL operators, T_CHR operations
  1041. * do not boil down to a simple operation.
  1042. */
  1043. #include <stdio.h>
  1044.  
  1045. main(argc,argv)
  1046. char **argv;
  1047. int argc;
  1048. {
  1049. char *name,*type,*oper,*tag;
  1050.  
  1051. if(argc != 5) {
  1052.     fprintf(stderr,"arg count\n");
  1053.     exit(1);
  1054. }
  1055. name = argv[1]; type = argv[2]; oper = argv[3]; tag = argv[4];
  1056.  
  1057. printf("_%s(l,p)\n",name);
  1058. printf("int (*l[])(),p;\n");
  1059. printf("{\n");
  1060. printf("    union value rg1,rg2,result;\n");
  1061. printf("\n");
  1062. printf("    if((status&XMODE)==M_READ){ dtype=T_%s; goto EXEC;}\n",type);
  1063. printf("    if((status&XMODE) == M_EXECUTE) {\n");
  1064. printf("EXEC:\n");
  1065. printf("    rg2 = pop();\n");
  1066. printf("    rg1 = pop();\n");
  1067. printf("    result.%s = rg1.%s %s rg2.%s;\n",tag,tag,oper,tag);
  1068. printf("    push(result);\n");
  1069. printf("    }\n");
  1070. printf("    return(p);\n");
  1071. printf("}\n");
  1072. }
  1073. SHAR_EOF
  1074. if test 1030 -ne "`wc -c < 'newbs/mkop.c'`"
  1075. then
  1076.     echo shar: error transmitting "'newbs/mkop.c'" '(should have been 1030 characters)'
  1077. fi
  1078. fi # end of overwriting check
  1079. echo shar: extracting "'newbs/mkop.sh'" '(482 characters)'
  1080. if test -f 'newbs/mkop.sh'
  1081. then
  1082.     echo shar: will not over-write existing file "'newbs/mkop.sh'"
  1083. else
  1084. sed 's/^X//' << \SHAR_EOF > 'newbs/mkop.sh'
  1085. echo "/* operat2.c -- more operators for bs.  the ones that are all alike."
  1086. echo " */"
  1087. echo ""
  1088. echo "#include \"bsdefs.h\""
  1089. echo ""
  1090. op "radd" "DBL" "+" "rval" 
  1091. op "rsub" "DBL" "-" "rval" 
  1092. op "rmult" "DBL" "*" "rval" 
  1093. op "rdiv" "DBL" "/" "rval" 
  1094. rop "req" "=="
  1095. sop "seq" "=="
  1096. rop "rneq" "!="
  1097. sop "sneq" "!="
  1098. rop "rleq" "<="
  1099. sop "sleq" "<="
  1100. rop "rlt" "<"
  1101. sop "slt" "<"
  1102. rop "rgeq" ">="
  1103. sop "sgeq" ">="
  1104. rop "rgt" ">"
  1105. sop "sgt" ">"
  1106. op "or" "INT" "||" "ival" 
  1107. op "and" "INT" "&&" "ival" 
  1108. SHAR_EOF
  1109. if test 482 -ne "`wc -c < 'newbs/mkop.sh'`"
  1110. then
  1111.     echo shar: error transmitting "'newbs/mkop.sh'" '(should have been 482 characters)'
  1112. fi
  1113. chmod +x 'newbs/mkop.sh'
  1114. fi # end of overwriting check
  1115. echo shar: extracting "'newbs/mksop.c'" '(725 characters)'
  1116. if test -f 'newbs/mksop.c'
  1117. then
  1118.     echo shar: will not over-write existing file "'newbs/mksop.c'"
  1119. else
  1120. sed 's/^X//' << \SHAR_EOF > 'newbs/mksop.c'
  1121. /* mksop.c -- make string comparator functions for bs.
  1122. *
  1123. *    USAGE: op name oper
  1124. *
  1125. * where:    name: name of function generated.
  1126. *        oper: operator for operation.
  1127. */
  1128. #include <stdio.h>
  1129.  
  1130. main(argc,argv)
  1131. char **argv;
  1132. int argc;
  1133. {
  1134. char *name,*oper;
  1135.  
  1136. if(argc != 3) {
  1137.     fprintf(stderr,"arg count\n");
  1138.     exit(1);
  1139. }
  1140. name = argv[1]; oper = argv[2];
  1141.  
  1142. printf("_%s(l,p)\n",name);
  1143. printf("int (*l[])(),p;\n");
  1144. printf("{\n");
  1145. printf("    union value rg1,rg2,result;\n");
  1146. printf("\n");
  1147. printf("    if((status&XMODE) == M_EXECUTE) {\n");
  1148. printf("    rg2 = pop();\n");
  1149. printf("    rg1 = pop();\n");
  1150. printf("    result.sval = strcmp(rg1.sval,rg2.sval) %s 0;\n",oper);
  1151. printf("    push(result);\n");
  1152. printf("    }\n");
  1153. printf("    return(p);\n");
  1154. printf("}\n");
  1155. }
  1156. SHAR_EOF
  1157. if test 725 -ne "`wc -c < 'newbs/mksop.c'`"
  1158. then
  1159.     echo shar: error transmitting "'newbs/mksop.c'" '(should have been 725 characters)'
  1160. fi
  1161. fi # end of overwriting check
  1162. echo shar: extracting "'newbs/num_ins.c'" '(3393 characters)'
  1163. if test -f 'newbs/num_ins.c'
  1164. then
  1165.     echo shar: will not over-write existing file "'newbs/num_ins.c'"
  1166. else
  1167. sed 's/^X//' << \SHAR_EOF > 'newbs/num_ins.c'
  1168. /* int_in() -- tokenizer routine for inputting a number.
  1169.  * int_in() returns a pointer to a static data area.  This area gets 
  1170.  * overwritten with each call to int_in so use the data before calling
  1171.  * int_in() again.
  1172.  */
  1173. char * int_in()
  1174. {
  1175.     register char c,*s;
  1176.     static char text[20];
  1177.  
  1178.     s = &text[0];
  1179.  
  1180. /* beginning state, skip junk until either '-' or ['0'-'9'] comes along */
  1181.  
  1182. l1: c=input();
  1183.     if(c>='0' && c<='9') goto l3;
  1184.     else if(c == '-') goto l2;
  1185.     else {
  1186.     if(c=='\n' || c=='\0') rdlin(bsin);
  1187.     goto l1;
  1188.     }
  1189.  
  1190. /* skipped junk, seen '-', gather it and make sure next char is a digit */
  1191.  
  1192. l2: *s++ = c;
  1193.     c=input();
  1194.     if(c==' ' || c=='\t') goto l2; /* allow white between sign and digit */
  1195.     else if(c>='0' && c<='9') goto l3;
  1196.     else { /* seen something not allowed. */
  1197.     s = &text[0];
  1198.     printf("\n\007??");
  1199.     goto l1; /* restart machine */
  1200.     }
  1201.  
  1202. /* skipped junk, seen a digit, gather until a non-digit appears */
  1203.  
  1204. l3: *s++ = c;
  1205.     c=input();
  1206.     if(c>='0' && c<='9') goto l3;
  1207.     else {
  1208.     /* have reached successful conclusion to machine. */
  1209.     unput(c);
  1210.     *s++ = '\0';
  1211.     return(text);
  1212.     }
  1213. }
  1214.  
  1215. /* real_in() -- read in a floating point number using input().
  1216.  *
  1217.  * real_in() returns a pointer to a static data area.  This data area
  1218.  * gets overwritten with each call to real_in(), so use it quickly.
  1219.  */
  1220. char *real_in()
  1221. {
  1222.     register char *s,c;
  1223.     static char bf[30];
  1224.  
  1225.     s = &bf[0];
  1226.  
  1227. /* starting state.  loops back until something interesting seen */
  1228.  
  1229. state1:    c=input();
  1230.     if(c == '-') goto state3;
  1231.     else if(c>='0' && c<='9') goto state2;
  1232.     else if(c == '.') goto state4;
  1233.     else {
  1234.         if(c == '\0') return(0);
  1235.         /* else */
  1236.         if(c == '\n') rdlin(bsin);
  1237.         goto state1;
  1238.     }
  1239.  
  1240. /* seen ([sign] dig). loop back for digs, looking for (.|e|E) */
  1241.  
  1242. state2: *s++ = c;
  1243.     c=input();
  1244.     if(c>='0' && c<='9') goto state2;
  1245.     else if(c=='e' || c=='E') goto state6;
  1246.     else if(c == '.') goto state4;
  1247.     else goto state9;    /* done */
  1248.  
  1249. /* seen (sign).  looking for (dig). ignore whitespace. */
  1250.  
  1251. state3: *s++ = c;
  1252. state3_a: c=input();
  1253.     if(c==' ' || c=='\t') goto state3_a;
  1254.     else if(c>='0' && c<='9') goto state2;
  1255.     else if(c == '.') goto state4;
  1256.     else goto state10;    /* error, had a sign so we have to have digs. */
  1257.  
  1258. /* seen ([sign] digs '.').  looking for digs.  done on anything else */
  1259.  
  1260. state4: *s++ = c;
  1261.     c=input();
  1262.     if(c>='0' && c<='9') goto state5;
  1263.     else goto state9;    /* done */
  1264.  
  1265. /* seen ([sign] digs '.' dig).  looking for (dig|e|E). done on anything else */
  1266.  
  1267. state5:    *s++ = c;
  1268.     c=input();
  1269.     if(c=='e' || c=='E') goto state6;
  1270.     else if(c>='0' && c<='9') goto state5;
  1271.     else goto state9;
  1272.  
  1273. /* seen ([sign] digs '.' digs (e|E)). looking for sign or digs, else error. */
  1274.  
  1275. state6: *s++ = c;
  1276.     c=input();
  1277.     if(c=='+' || c=='-') goto state7;
  1278.     else if(c>='0' && c<='9') goto state8;
  1279.     else goto state10;    /* error */
  1280.  
  1281. /* seen ([sign] digs '.' digs (e|E) sign). looking for digs, else error. */
  1282.  
  1283. state7: *s++ = c;
  1284.     c=input();
  1285.     if(c>='0' && c<='9') goto state8;
  1286.     else goto state10;    /* error */
  1287.  
  1288. /* seen ([sign] digs '.' digs (e|E) [sign] dig). looking for digs. */
  1289.  
  1290. state8: *s++ = c;
  1291.     c=input();
  1292.     if(c>='0' && c<='9') goto state8;
  1293.     else goto state9;    /* done */
  1294.  
  1295. /* seen a complete number.  machine successfully completed.  whew! */
  1296.  
  1297. state9: unput(c);    /* might want that later */
  1298.     *s++ = '\0';
  1299.     return(bf);
  1300.  
  1301. /* Uh oh.  An error.  Print an error and restart. */
  1302.  
  1303. state10: printf("\n\007??");
  1304.     s = &bf[0];
  1305.     goto state1;
  1306. }
  1307. SHAR_EOF
  1308. if test 3393 -ne "`wc -c < 'newbs/num_ins.c'`"
  1309. then
  1310.     echo shar: error transmitting "'newbs/num_ins.c'" '(should have been 3393 characters)'
  1311. fi
  1312. fi # end of overwriting check
  1313. echo shar: extracting "'newbs/op2.c'" '(4171 characters)'
  1314. if test -f 'newbs/op2.c'
  1315. then
  1316.     echo shar: will not over-write existing file "'newbs/op2.c'"
  1317. else
  1318. sed 's/^X//' << \SHAR_EOF > 'newbs/op2.c'
  1319. /* operat2.c -- more operators for bs.  the ones that are all alike.
  1320.  */
  1321.  
  1322. #include "bsdefs.h"
  1323.  
  1324. _radd(l,p)
  1325. int (*l[])(),p;
  1326. {
  1327.     union value rg1,rg2,result;
  1328.  
  1329.     if((status&XMODE)==M_READ){ dtype=T_DBL; goto EXEC;}
  1330.     if((status&XMODE) == M_EXECUTE) {
  1331. EXEC:
  1332.     rg2 = pop();
  1333.     rg1 = pop();
  1334.     result.rval = rg1.rval + rg2.rval;
  1335.     push(result);
  1336.     }
  1337.     return(p);
  1338. }
  1339. _rsub(l,p)
  1340. int (*l[])(),p;
  1341. {
  1342.     union value rg1,rg2,result;
  1343.  
  1344.     if((status&XMODE)==M_READ){ dtype=T_DBL; goto EXEC;}
  1345.     if((status&XMODE) == M_EXECUTE) {
  1346. EXEC:
  1347.     rg2 = pop();
  1348.     rg1 = pop();
  1349.     result.rval = rg1.rval - rg2.rval;
  1350.     push(result);
  1351.     }
  1352.     return(p);
  1353. }
  1354. _rmult(l,p)
  1355. int (*l[])(),p;
  1356. {
  1357.     union value rg1,rg2,result;
  1358.  
  1359.     if((status&XMODE)==M_READ){ dtype=T_DBL; goto EXEC;}
  1360.     if((status&XMODE) == M_EXECUTE) {
  1361. EXEC:
  1362.     rg2 = pop();
  1363.     rg1 = pop();
  1364.     result.rval = rg1.rval * rg2.rval;
  1365.     push(result);
  1366.     }
  1367.     return(p);
  1368. }
  1369. _rdiv(l,p)
  1370. int (*l[])(),p;
  1371. {
  1372.     union value rg1,rg2,result;
  1373.  
  1374.     if((status&XMODE)==M_READ){ dtype=T_DBL; goto EXEC;}
  1375.     if((status&XMODE) == M_EXECUTE) {
  1376. EXEC:
  1377.     rg2 = pop();
  1378.     rg1 = pop();
  1379.     result.rval = rg1.rval / rg2.rval;
  1380.     push(result);
  1381.     }
  1382.     return(p);
  1383. }
  1384. _req(l,p)
  1385. int (*l[])(),p;
  1386. {
  1387.     union value rg1,rg2,result;
  1388.  
  1389.     if((status&XMODE) == M_EXECUTE) {
  1390.     rg2 = pop();
  1391.     rg1 = pop();
  1392.     result.ival = rg1.rval == rg2.rval;
  1393.     push(result);
  1394.     }
  1395.     return(p);
  1396. }
  1397. _seq(l,p)
  1398. int (*l[])(),p;
  1399. {
  1400.     union value rg1,rg2,result;
  1401.  
  1402.     if((status&XMODE) == M_EXECUTE) {
  1403.     rg2 = pop();
  1404.     rg1 = pop();
  1405.     result.sval = strcmp(rg1.sval,rg2.sval) == 0;
  1406.     push(result);
  1407.     }
  1408.     return(p);
  1409. }
  1410. _rneq(l,p)
  1411. int (*l[])(),p;
  1412. {
  1413.     union value rg1,rg2,result;
  1414.  
  1415.     if((status&XMODE) == M_EXECUTE) {
  1416.     rg2 = pop();
  1417.     rg1 = pop();
  1418.     result.ival = rg1.rval != rg2.rval;
  1419.     push(result);
  1420.     }
  1421.     return(p);
  1422. }
  1423. _sneq(l,p)
  1424. int (*l[])(),p;
  1425. {
  1426.     union value rg1,rg2,result;
  1427.  
  1428.     if((status&XMODE) == M_EXECUTE) {
  1429.     rg2 = pop();
  1430.     rg1 = pop();
  1431.     result.sval = strcmp(rg1.sval,rg2.sval) != 0;
  1432.     push(result);
  1433.     }
  1434.     return(p);
  1435. }
  1436. _rleq(l,p)
  1437. int (*l[])(),p;
  1438. {
  1439.     union value rg1,rg2,result;
  1440.  
  1441.     if((status&XMODE) == M_EXECUTE) {
  1442.     rg2 = pop();
  1443.     rg1 = pop();
  1444.     result.ival = rg1.rval <= rg2.rval;
  1445.     push(result);
  1446.     }
  1447.     return(p);
  1448. }
  1449. _sleq(l,p)
  1450. int (*l[])(),p;
  1451. {
  1452.     union value rg1,rg2,result;
  1453.  
  1454.     if((status&XMODE) == M_EXECUTE) {
  1455.     rg2 = pop();
  1456.     rg1 = pop();
  1457.     result.sval = strcmp(rg1.sval,rg2.sval) <= 0;
  1458.     push(result);
  1459.     }
  1460.     return(p);
  1461. }
  1462. _rlt(l,p)
  1463. int (*l[])(),p;
  1464. {
  1465.     union value rg1,rg2,result;
  1466.  
  1467.     if((status&XMODE) == M_EXECUTE) {
  1468.     rg2 = pop();
  1469.     rg1 = pop();
  1470.     result.ival = rg1.rval < rg2.rval;
  1471.     push(result);
  1472.     }
  1473.     return(p);
  1474. }
  1475. _slt(l,p)
  1476. int (*l[])(),p;
  1477. {
  1478.     union value rg1,rg2,result;
  1479.  
  1480.     if((status&XMODE) == M_EXECUTE) {
  1481.     rg2 = pop();
  1482.     rg1 = pop();
  1483.     result.sval = strcmp(rg1.sval,rg2.sval) < 0;
  1484.     push(result);
  1485.     }
  1486.     return(p);
  1487. }
  1488. _rgeq(l,p)
  1489. int (*l[])(),p;
  1490. {
  1491.     union value rg1,rg2,result;
  1492.  
  1493.     if((status&XMODE) == M_EXECUTE) {
  1494.     rg2 = pop();
  1495.     rg1 = pop();
  1496.     result.ival = rg1.rval >= rg2.rval;
  1497.     push(result);
  1498.     }
  1499.     return(p);
  1500. }
  1501. _sgeq(l,p)
  1502. int (*l[])(),p;
  1503. {
  1504.     union value rg1,rg2,result;
  1505.  
  1506.     if((status&XMODE) == M_EXECUTE) {
  1507.     rg2 = pop();
  1508.     rg1 = pop();
  1509.     result.sval = strcmp(rg1.sval,rg2.sval) >= 0;
  1510.     push(result);
  1511.     }
  1512.     return(p);
  1513. }
  1514. _rgt(l,p)
  1515. int (*l[])(),p;
  1516. {
  1517.     union value rg1,rg2,result;
  1518.  
  1519.     if((status&XMODE) == M_EXECUTE) {
  1520.     rg2 = pop();
  1521.     rg1 = pop();
  1522.     result.ival = rg1.rval > rg2.rval;
  1523.     push(result);
  1524.     }
  1525.     return(p);
  1526. }
  1527. _sgt(l,p)
  1528. int (*l[])(),p;
  1529. {
  1530.     union value rg1,rg2,result;
  1531.  
  1532.     if((status&XMODE) == M_EXECUTE) {
  1533.     rg2 = pop();
  1534.     rg1 = pop();
  1535.     result.sval = strcmp(rg1.sval,rg2.sval) > 0;
  1536.     push(result);
  1537.     }
  1538.     return(p);
  1539. }
  1540. _or(l,p)
  1541. int (*l[])(),p;
  1542. {
  1543.     union value rg1,rg2,result;
  1544.  
  1545.     if((status&XMODE)==M_READ){ dtype=T_INT; goto EXEC;}
  1546.     if((status&XMODE) == M_EXECUTE) {
  1547. EXEC:
  1548.     rg2 = pop();
  1549.     rg1 = pop();
  1550.     result.ival = rg1.ival || rg2.ival;
  1551.     push(result);
  1552.     }
  1553.     return(p);
  1554. }
  1555. _and(l,p)
  1556. int (*l[])(),p;
  1557. {
  1558.     union value rg1,rg2,result;
  1559.  
  1560.     if((status&XMODE)==M_READ){ dtype=T_INT; goto EXEC;}
  1561.     if((status&XMODE) == M_EXECUTE) {
  1562. EXEC:
  1563.     rg2 = pop();
  1564.     rg1 = pop();
  1565.     result.ival = rg1.ival && rg2.ival;
  1566.     push(result);
  1567.     }
  1568.     return(p);
  1569. }
  1570. SHAR_EOF
  1571. if test 4171 -ne "`wc -c < 'newbs/op2.c'`"
  1572. then
  1573.     echo shar: error transmitting "'newbs/op2.c'" '(should have been 4171 characters)'
  1574. fi
  1575. fi # end of overwriting check
  1576. echo shar: extracting "'newbs/operat.c'" '(8663 characters)'
  1577. if test -f 'newbs/operat.c'
  1578. then
  1579.     echo shar: will not over-write existing file "'newbs/operat.c'"
  1580. else
  1581. sed 's/^X//' << \SHAR_EOF > 'newbs/operat.c'
  1582. /* operat.c -- operations, as opposed to actions.  FOR is an action,
  1583.  *    '+' is an operation.
  1584.  *
  1585.  * More operators can be found in the machine generated file "operat2.c".
  1586.  */
  1587.  
  1588. #include "bsdefs.h"
  1589.  
  1590.  
  1591. /*    BINARY OPERATORS    */
  1592.  
  1593. /* Common description for the binary ops.
  1594.  *  also applies to all ops in operat2.c
  1595.  *
  1596.  * M_COMPILE:
  1597.  *    x op x   --to--   x,_op,x
  1598.  * M_EXECUTE:
  1599.  *    stack: ar2,ar1,x   --to--   (ar1 op ar2),x
  1600.  */
  1601.  
  1602.  
  1603. _comma(l,p) int (*l[])(),p;
  1604. {
  1605.     union value s1,s2,s3;
  1606.     if((status&XMODE) == M_FIXUP) return(p);
  1607.     if((status&XMODE) == M_READ) { dtype = T_CHR; goto EXEC; }
  1608.     if((status&XMODE) == M_EXECUTE) {
  1609. EXEC:
  1610.         s1 = pop();
  1611.         s2 = pop();
  1612.         s3.sval = myalloc(strlen(s1.sval)+strlen(s2.sval)+3);
  1613.         strcpy(s3.sval,s2.sval);
  1614.         strcat(s3.sval,"\t");
  1615.         strcat(s3.sval,s1.sval);
  1616.         if(s1.sval != 0) free(s1.sval);
  1617.         if(s2.sval != 0) free(s2.sval);
  1618.         push(s3);
  1619.     }
  1620.         return(p);
  1621. }
  1622. _scolon(l,p) int(*l[])(),p;
  1623. {
  1624.     union value s1,s2,s3;
  1625.     if((status&XMODE) == M_READ) { dtype = T_CHR; goto EXEC; }
  1626.     if((status&XMODE) == M_EXECUTE) {
  1627. EXEC:
  1628.         s1 = pop();
  1629.         s2 = pop();
  1630.         s3.sval = myalloc(strlen(s1.sval)+strlen(s2.sval)+2);
  1631.         strcpy(s3.sval,s2.sval);
  1632.         strcat(s3.sval,s1.sval);
  1633.         push(s3);
  1634.         if(s1.sval != 0) free(s1.sval);
  1635.         if(s2.sval != 0) free(s2.sval);
  1636.     }
  1637.     return(p);
  1638. }
  1639. /* last of binary operators */
  1640.  
  1641. /* ---And now for something completely different: a Unary Operator.
  1642.  *
  1643.  * M_COMPILE:
  1644.  *    x not x    --to--    x,_not,x
  1645.  * M_EXECUTE:
  1646.  *    stack: bool,x    --to--     !(bool),x
  1647.  */
  1648. _not(l,p) int (*l[])(),p;
  1649. {
  1650.     union value val;
  1651.  
  1652.     if((status&XMODE) == M_EXECUTE) {
  1653.     val = pop();
  1654.     val.ival = ! val.ival;
  1655.     push(val);
  1656.     }
  1657.     return(p);
  1658. }
  1659.  
  1660. /* M_COMPILE:
  1661.  *    x itoa x   --to--   x,_itoa,x
  1662.  * M_EXECUTE:
  1663.  *    stack: int,x   --to--   string,x
  1664.  */
  1665. _itoa(l,p)
  1666. int (*l[])(),p;
  1667. {
  1668.     union value val;
  1669.     char s2[30];
  1670.  
  1671.     if((status&XMODE) == M_READ) { dtype = T_CHR; goto EXEC; }
  1672.     if((status&XMODE) == M_EXECUTE) {
  1673. EXEC:
  1674.         val=pop();
  1675.         sprintf(s2,"%D",val.ival);    /* optimize later */
  1676. if(dbg) printf("_icon():M_EXECUTE:ival:%D to sval:%s\n",val.ival,s2);
  1677.         val.sval=myalloc(strlen(s2)+1);
  1678.         strcpy(val.sval,s2);
  1679.         push(val);
  1680.     }
  1681.     return(p);
  1682. }
  1683. _rtoa(l,p)
  1684. int (*l[])(),p;
  1685. {
  1686.     union value val;
  1687.     char s2[30];
  1688.  
  1689.     if((status&XMODE) == M_READ) { dtype = T_CHR; goto EXEC; }
  1690.     if((status&XMODE) == M_EXECUTE) {
  1691. EXEC:
  1692.         val = pop();
  1693.         sprintf(s2,"%g",val.rval);
  1694. if(dbg) printf("_rtoa():M_EXECUTE:rval:%g to sval:%s\n",val.rval,s2);
  1695.         val.sval = myalloc(strlen(s2)+1);
  1696.         strcpy(val.sval,s2);
  1697.         push(val);
  1698.     }
  1699.     return(p);
  1700. }
  1701. _itor(l,p)
  1702. int (*l[])(),p;
  1703. {
  1704.     union value v1,v2;
  1705.  
  1706.     if((status&XMODE) == M_READ) { dtype = T_DBL; goto EXEC; }
  1707.     if((status&XMODE) == M_EXECUTE) {
  1708. EXEC:
  1709.         v1 = pop();
  1710.         v2.rval = (double)v1.ival;
  1711.         push(v2);
  1712.     }
  1713.     return(p);
  1714. }
  1715. _rtoi(l,p)
  1716. int (*l[])(),p;
  1717. {
  1718.     union value v1,v2;
  1719.  
  1720.     if((status&XMODE) == M_READ) { dtype = T_INT; goto EXEC; }
  1721.     if((status&XMODE) == M_EXECUTE) {
  1722. EXEC:
  1723.         v1 = pop();
  1724.         v2.ival = (int)v1.rval;
  1725.         push(v2);
  1726.     }
  1727.     return(p);
  1728. }
  1729.  
  1730. /* M_COMPILE:
  1731.  *    x scon "quoted string" x   --to--   x,_scon,&string,x
  1732.  * M_EXECUTE:
  1733.  *    stack: x   --to--   string,x
  1734.  *    other: pushes a COPY of the string, not the original.
  1735.  */
  1736. _scon(l,p)
  1737. int (*l[])(),p;
  1738. {
  1739.     char *s,c;
  1740.     union value val;
  1741.     int i;
  1742.  
  1743.     if((status&XMODE) == M_FIXUP) ++p;
  1744.     if((status&XMODE) == M_READ) { dtype = T_CHR; goto EXEC; }
  1745.     if((status&XMODE) == M_EXECUTE) {
  1746. EXEC:
  1747.         s = l[p++];
  1748.         val.sval = myalloc(strlen(s)+1);
  1749.         strcpy(val.sval,s);
  1750.         push(val);
  1751. if(dbg) printf("_scon():M_EXECUTE:sval:%s\n",val.sval);
  1752.     }
  1753.     return(p);
  1754. }
  1755.  
  1756. /* M_COMPILE:
  1757.  *    x icon int x   --to--   x,_icon,int,x
  1758.  * M_EXECUTE:
  1759.  *    stack: x   --to--   int,x
  1760.  */
  1761. _icon(l,p)
  1762. int (*l[])(),p;
  1763. {
  1764.     union value val;
  1765.     union loni v;
  1766.     int i;
  1767.  
  1768.     if((status&XMODE) == M_FIXUP) return(p+(sizeof(long)/sizeof(int)));
  1769.     if((status&XMODE) == M_READ) { dtype = T_INT; goto EXEC; }
  1770.     if((status&XMODE) == M_EXECUTE) {
  1771. EXEC:
  1772.         for(i=0; i<(sizeof(long)/sizeof(int)); i++)
  1773.         v.i_in_loni[i] = l[p++];
  1774.         val.ival = v.l_in_loni;
  1775.         push(val);
  1776. if(dbg) printf("_icon():M_EXECUTE:ival:%D\n",val.ival);
  1777.     }
  1778.     return(p);
  1779. }
  1780. _rcon(l,p)
  1781. int (*l[])(),p;
  1782. {
  1783.     union doni v;
  1784.     int i;
  1785.     union value val;
  1786.  
  1787.     if((status&XMODE) == M_FIXUP) return(p+(sizeof(double)/sizeof(int)));
  1788.     if((status&XMODE) == M_READ) { dtype = T_DBL; goto EXEC; }
  1789.     if((status&XMODE) = M_EXECUTE) {
  1790. EXEC:
  1791.         for(i=0; i<(sizeof(double)/sizeof(int)); i++)
  1792.         v.i_in_doni[i] = l[p++];
  1793.         val.rval = v.d_in_doni;
  1794.         push(val);
  1795.     }
  1796.     return(p);
  1797. }
  1798.  
  1799. /* M_COMPILE:
  1800.  *    x val type x   --to--   x,_val,type,x
  1801.  * M_EXECUTE:
  1802.  *    stack:    place,x   --to--   value,x
  1803.  *    other: for strings, pushes a copy of the string.
  1804.  */
  1805. _val(l,p) int(*l[])(),p;
  1806. {
  1807.     union value place,val;
  1808.     int ty;
  1809.  
  1810.     if((status&XMODE) == M_READ) { dtype = l[p]; goto EXEC; }
  1811.     if((status&XMODE) == M_EXECUTE) {
  1812. EXEC:
  1813.         ty = l[p];
  1814.         place = pop();
  1815. if(dbg) printf("_val():M_EXECUTE:var:%s",place.vpval->name);
  1816.         place.plval = getplace(place.vpval);
  1817.         if(ty==T_CHR && place.plval->sval!=0) {
  1818.         val.sval = myalloc(strlen(place.plval->sval)+1);
  1819.         strcpy(val.sval,place.plval->sval);
  1820.         push(val);
  1821.         }
  1822.         else push(*place.plval);
  1823. if(dbg) printf(":ival:%D:rval:%g:sval:%s\n",ty==T_INT?place.plval->ival:(long)0,
  1824.     ty==T_DBL?place.plval->rval:(double)0,ty==T_CHR?place.plval->sval:0);
  1825.     }
  1826.     return(p+1);
  1827. }
  1828.  
  1829. /* M_COMPILE:
  1830.  *    x store typ x   --to--    x,_store,type,x
  1831.  * M_EXECUTE:
  1832.  *    stack: value,location,x   --to--   value,x
  1833.  *        (stores value at location).
  1834.  */
  1835. _store(l,p) int(*l[])(),p;
  1836. {
  1837.     union value place,val;
  1838.     int ty;
  1839.  
  1840.     if((status&XMODE) == M_READ) { dtype = l[p]; goto EXEC; }
  1841.     if((status&XMODE) == M_EXECUTE) {
  1842. EXEC:
  1843.         val = pop();
  1844.         place = pop();
  1845.         ty = l[p];
  1846. if(dbg) printf("_store():M_EXECUTE:var:%s:ival:%D:rval:%g:sval:%s\n",
  1847.     place.vpval->name,ty==T_INT?val.ival:(long)0,ty==T_DBL?val.rval:(double)0,ty==T_CHR?val.sval:0);
  1848.         place.plval = getplace(place.vpval);
  1849.         if(ty==T_CHR && place.plval->sval!=0) free(place.plval->sval);
  1850.         (*place.plval) = val;
  1851.         push(val);
  1852.     }
  1853.     return(p+1);
  1854. }
  1855.  
  1856. /* M_COMPILE:
  1857.  *    x var typ name x   --to--    x,_var,&vlist entry,x
  1858.  * M_EXECUTE:
  1859.  *    stack: x   --to--   &vlist entry,x
  1860.  * M_INPUT:
  1861.  *    (&vlist entry)->val is set to input value.
  1862.  * M_READ:
  1863.  *    Moves the data list pointers to the next data item.  If no next
  1864.  *    data item, calls ODerror.
  1865.  *    Does a "gosub" to the data item, to get its value on the stack.
  1866.  *    Does T_INT to T_CHR conversion if necessary.
  1867.  *    Pops value into vp->val.
  1868.  */
  1869. _var(l,p) int(*l[])(),p; /* same proc for any variable type */
  1870. {
  1871.     char *s;
  1872.     struct dictnode *vp;
  1873.     struct line *thislist;
  1874.     union value place,val;
  1875.     int ty,qual;
  1876.  
  1877.     if((status&XMODE) == M_EXECUTE) {
  1878.         val.vpval = l[p++];
  1879. if(dbg) printf("_var():M_EXECUTE:var:(%d)%s\n",val.vpval->type_of_value,
  1880.     val.vpval->name);
  1881.         push(val);
  1882.         return(p);
  1883.     }
  1884.     if((status&XMODE) == M_INPUT) {
  1885.         vp = l[p++];
  1886.         place.plval = getplace(vp);
  1887.         ty = (vp->type_of_value) & T_TMASK;
  1888.         if(ty == T_INT)
  1889.         place.plval->ival = atol(int_in());
  1890.         else if(ty == T_DBL)
  1891.         place.plval->rval = atof(real_in());
  1892.         else /* ty == T_CHR */
  1893.         place.plval->sval = scon_in();
  1894. if(dbg) printf("_var():M_INPUT:var:(%d)%s:ival:%D:rval:%g:sval:%s\n",
  1895. vp->type_of_value,vp->name,ty==T_INT?place.plval->ival:(long)0,
  1896. ty==T_DBL?place.plval->rval:(double)0,ty==T_CHR?place.plval->sval:0);
  1897.         return(p);
  1898.     }
  1899.     if((status&XMODE) == M_READ) {
  1900. nxdl:        if(dlist[dlp] == 0) ODerror(l,p);    /* ran off end of dlist */
  1901.         thislist = dlist[dlp];
  1902.         if((thislist->code)[dlindx] == 0) {
  1903.         dlp++;
  1904.         dlindx = 2;    /* skips <_data,0> */
  1905.         goto nxdl;
  1906.         }
  1907.  
  1908.         status = M_EXECUTE;
  1909.         dlindx = interp(thislist->code,dlindx);
  1910.         status = M_READ;
  1911.  
  1912.         val = pop();
  1913.         vp = l[p];
  1914.         place.plval = getplace(vp);
  1915.         qual = vp->type_of_value&T_TMASK;
  1916.         if(qual == T_INT) {
  1917.         if(dtype == T_DBL) {
  1918.             push(val); _rtoi(l,p); val = pop();
  1919.         }
  1920.         place.plval->ival = val.ival;
  1921.         }
  1922.         else if(qual == T_DBL) {
  1923.         if(dtype == T_INT) {
  1924.             push(val); _itor(l,p); val = pop();
  1925.         }
  1926.         place.plval->rval = val.rval;
  1927.         }
  1928.         else if(qual == T_CHR) {
  1929.         if(dtype == T_INT) {
  1930.             push(val); _itoa(l,p); val = pop();
  1931.         }
  1932.         else if(dtype == T_DBL) {
  1933.             push(val); _rtoa(l,p); val = pop();
  1934.         }
  1935.         if(place.plval->sval != 0) free(place.plval->sval);
  1936.         place.plval->sval = myalloc(strlen(val.sval)+1);
  1937.         strcpy(place.plval->sval,val.sval);
  1938.         }
  1939.         else VTerror(l,p);
  1940.     return(p+1);
  1941.     }
  1942.     return(p+1);
  1943. }
  1944. SHAR_EOF
  1945. if test 8663 -ne "`wc -c < 'newbs/operat.c'`"
  1946. then
  1947.     echo shar: error transmitting "'newbs/operat.c'" '(should have been 8663 characters)'
  1948. fi
  1949. fi # end of overwriting check
  1950. echo shar: extracting "'newbs/scon_in.c'" '(1454 characters)'
  1951. if test -f 'newbs/scon_in.c'
  1952. then
  1953.     echo shar: will not over-write existing file "'newbs/scon_in.c'"
  1954. else
  1955. sed 's/^X//' << \SHAR_EOF > 'newbs/scon_in.c'
  1956. /* scon_in() -- read in a string constant using input.
  1957.  *    Format of an scon is either a quoted string, or a sequence
  1958.  *    of characters ended with a seperator (' ', '\t' or '\n' or ',').
  1959.  *
  1960.  *    In either mode, you can get funny characters into the string by
  1961.  *    "quoting" them with a '\'.
  1962.  *
  1963.  * scon_in() uses myalloc() to create space to store the string in.
  1964.  */
  1965. char *scon_in()
  1966. {
  1967.     register char c,*s;
  1968.     static char text [80];
  1969.  
  1970.     s = &text[0];
  1971.  
  1972. /* beginning state, skip seperators until something interesting comes along */
  1973.  
  1974. l1: c=input();
  1975.     if(c == '"') goto l2;
  1976.     else if(c=='\n' || c=='\0') {
  1977.     rdlin(bsin);
  1978.     goto l1;
  1979.     }
  1980.     else if(c==' ' || c=='\t' || c==',') goto l1;
  1981.     else goto l3;
  1982.  
  1983. /* have skipped unwanted material, seen a '"', read in a quoted string */
  1984.  
  1985. l2: c=input();
  1986.     if(c == '\n') {
  1987.     fprintf(stderr,"scon_in: unterminated string\n");
  1988.     exit(1);
  1989.     }
  1990.     else if(c == '\\') { *s++ = bslash(bsin); goto l2; }
  1991.     else if(c == '"')
  1992.     if((c=input()) == '"') {
  1993.         *s++ = '"';
  1994.         goto l2;
  1995.     }
  1996.     else goto done;
  1997.     else { *s++ = c; goto l2; }
  1998.  
  1999. /* skipped unwanted, seen something interesting, not '"', gather until sep */
  2000.  
  2001. l3: *s++ = c;
  2002.     c=input();
  2003.     if(c == '\\') { c = bslash(bsin); goto l3; }
  2004.     else if(c==' ' || c=='\t' || c==',' || c=='\n') goto done;
  2005.     else goto l3;
  2006.  
  2007. /* final state (if machine finished ok.) */
  2008.  
  2009. done: unput(c);
  2010.     *s++ = '\0';
  2011.     s=myalloc(strlen(text)+1);
  2012.     strcpy(s,text);
  2013.     return(s);
  2014. }
  2015. SHAR_EOF
  2016. if test 1454 -ne "`wc -c < 'newbs/scon_in.c'`"
  2017. then
  2018.     echo shar: error transmitting "'newbs/scon_in.c'" '(should have been 1454 characters)'
  2019. fi
  2020. fi # end of overwriting check
  2021. #    End of shell archive
  2022. exit 0
  2023.